home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / Programming / Basic_Routines / BasicSubs / demos / MenuMaker.demo (.txt) < prev    next >
AmigaBASIC Source Code  |  1992-03-30  |  3KB  |  111 lines
  1. FOR i = 1 TO 4: MENU i,0,0,"":NEXT i
  2. CLEAR
  3. SCREEN 1,640,250,3,2
  4. WINDOW 2,"                            MENUMAKER DEMO",,0,1
  5. DIM choice$(16)
  6. GOSUB LOADCOLOURS
  7. GOSUB MENUDEMO1
  8. SYSTEM
  9.  
  10. LOADCOLOURS:
  11.   OPEN "BasicUtils&Subs:SetupFiles/Colours" FOR INPUT AS #1
  12.   FOR i = 0 TO 7
  13.   INPUT #1,a,b,c,c$
  14.   PALETTE i,a,b,c
  15.   NEXT i
  16.   CLOSE
  17.   RETURN
  18.   
  19. MENUDEMO1:
  20.   choicenum%=4
  21.   choice$(1)="Create a new menu in PURPLE & YELLOW."
  22.   choice$(2)="Clear the screen to RED for 5 seconds."
  23.   choice$(3)="AMIGA talks!"
  24.   choice$(4)="Finish Demo."
  25.   olcol=4:bgcol=5:COLOR ,0
  26.   GOSUB MENUMAKER
  27.   IF opt%=4 THEN RETURN
  28.   ON opt% GOSUB SUB1,SUB2,SUB3: GOTO MENUDEMO1
  29.  
  30. SUB1:
  31.   choicenum%=3
  32.   choice$(1)="All choices on this demo menu"
  33.   choice$(2)="Take you back to the main menu."
  34.   choice$(3)="Press 'A', 'B' or 'C'"
  35.   olcol=7:bgcol=6:COLOR ,0
  36.   GOSUB MENUMAKER
  37.   RETURN
  38.   
  39. SUB2:
  40.   COLOR ,2
  41.   CLS
  42.   settime=0
  43.   ON TIMER (5) GOSUB TENSECS
  44.   TIMER ON
  45.   WHILE settime=0
  46.   WEND
  47.   RETURN
  48.   
  49. TENSECS:
  50.   settime=1
  51.   RETURN
  52.     
  53. SUB3:
  54.   talk$="Hello, my name is Amiga."
  55.   SAY TRANSLATE$(talk$)
  56.   RETURN
  57.  
  58. MENUMAKER:
  59.   CLS
  60.   choice$(0)= "  THE FOLLOWING OPTIONS ARE AVAILABLE:  "
  61.   COLOR olcol,bgcol
  62.   linelen=LEN(choice$(1))
  63.   FOR i = 2 TO choicenum%
  64.     IF LEN(choice$(i)) > linelen THEN linelen = LEN(choice$(i))
  65.   NEXT i
  66.   linelen = linelen +3:IF linelen < LEN(choice$(0)) THEN linelen = LEN(choice$(0))
  67.   linest= 40-INT(linelen/2)
  68.   xs =(linest*8)-5:ys=5
  69.   xe=((linelen+linest)*8)+19:ye=((5+choicenum%)*8)+3
  70.   GOSUB RAISED
  71.   LOCATE 2,21
  72.   PRINT choice$(0)
  73.   FOR i = 1 TO choicenum%
  74.     LOCATE 3+i,linest +2: PRINT CHR$(64+i);". ";choice$(i)
  75.   NEXT i
  76.   PRINT 
  77.   opflag=0
  78.   WHILE opflag = 0
  79.     LOCATE 5+choicenum%,linest+2
  80.     PRINT "CHOICE -->                          ";
  81.     LOCATE ,linest+13
  82.     chce$=""
  83.     WHILE chce$ < "A" OR chce$ > CHR$(64+choicenum%)
  84.       chce$ = INPUT$(1):chce$=UCASE$(chce$)
  85.     WEND
  86.     opt%=ASC(chce$)-64
  87.     LOCATE 3+opt%,linest+2
  88.     COLOR bgcol,olcol
  89.     PRINT chce$;". ";choice$(opt%)
  90.     COLOR olcol,bgcol
  91.     LOCATE 5+choicenum%,linest +2
  92.     PRINT "PRESS <ENTER> TO ACCEPT THIS CHOICE ";
  93.     opt$=INPUT$(1)
  94.     IF opt$ <> CHR$(13) THEN
  95.       LOCATE 3+opt%,linest+2
  96.       PRINT chce$;". ";choice$(opt%)
  97.     ELSE
  98.       opflag=1
  99.     END IF
  100.   WEND
  101.   RETURN
  102.   
  103. RAISED:
  104.   LINE (xs,ys)-(xe,ye),olcol,b
  105.   LINE (xs-4,ys-2)-(xe+4,ye+2),olcol,b
  106.   LINE (xs-2,ys-1)-(xe+2,ye+1),olcol,b
  107.   LINE (xs+3,ys+1)-(xe-3,ye-1),bgcol,b
  108.   PAINT ((xs+xe)/2,(ys+ye)/2),bgcol
  109.   RETURN
  110.  
  111.